home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic1 / pro21 / menu.bas < prev    next >
BASIC Source File  |  1988-11-03  |  6KB  |  197 lines
  1. SUB MENU (VMENU%, HMENU%, ROW%, COL%, VAR$(), VSPACING%, HSPACING%, FG%, BG%, HLFG%, HLBG%, HELP$(), HROW%, HCOL%, HFG%, HBG%) STATIC
  2. '-------------------------------------------------------------------------
  3. '  THIS SUB DISPLAYS A 2 DIMENSIONAL MENU DEFINED BY THE ARRAY VAR$.
  4. '  EACH ELEMENT OF VAR$ IS DISPLAYED IN A SEPARATE ROW AND COLUMN, THE NUMBER
  5. '  OF ROW AND COLUMNS = NO. OF ELEMENTS IN THE ARRAY VAR$.
  6. '  IT STARTS IN POSITION ROW, COL OF THE SCREEN.
  7. '  VSPACING DETERMINES HOW MANY SPACES THE ROWS OF THE MENU ARE APART.
  8. '  HSPACING DETERMINES HOW MANY SPACES THE COLUMNS OF THE MENU ARE APART.
  9. '  THE 1ST ROW AND COLUMN IS INITIALLY HIGHLIGHTED, AND SUBSEQUENTLY THE
  10. '  HIGHLIGHT MOVES UP, DOWN, LEFT OR RIGHT AS THE ARROW KEYS ARE PRESSED.
  11. '  WHEN THE FIRST LETTER OF AN ITEM OF THE MENU IS PRESSED, THE HIGHLIGHT
  12. '  GOES TO THAT ITEM. IF THERE ARE SEVERAL ITEMS WITH THE SAME 1ST LETTER,
  13. '  THE FIRST ITEM IN THE MENU MATCHING THE LETTER IS SELECTED.
  14. '  WHEN AN ITEM IS HIGHLIGHTED, A HELP LINE, IF ANY, GIVEN BY THE ARRAY HELP$
  15. '  IS DISPLAYED, IN ROW HROW, AND COLUMN HCOL, WITH COLORS HFG AND HBG.
  16. '  FG AND BG ARE THE NORMAL FOREGROUND AND BACKGROUND COLOR CODES
  17. '  HLFG AND HLBG ARE THE HIGHLIGHT FOREGROUND AND BACKGROUND COLOR CODES
  18. '  WHEN THE ENTER KEY IS PRESSED, THE SUB RETURNS CONTROL TO THE
  19. '  CALLING PROGRAM, AND RETURNS VMENU% AND HMENU% EQUAL TO NUMBER OF THE
  20. '  ROW AND COLUMN OF THE ARRAY VAR$ THAT CONTAINS THE ITEM THAT HAD THE
  21. '  HIGHLIGHT WHEN THE ENTER KEY WAS PRESSED. IF Esc WAS PRESSED, THE SUB
  22. '  RETURNS WITH A VMENU% AND HMENU% VALUE OF 0.
  23. '-------------------------------------------------------------------------
  24.   COLOR HLFG%, HLBG%
  25.   LOCATE 25, 1
  26.   PRINT "Use 1st letter of any item or "; CHR$(24); " "; CHR$(25); " "; CHR$(26); " "; CHR$(27); " to highlight selection, then press "; CHR$(17) + CHR$(196) + CHR$(217); 'PICTURE OF CR
  27.   VN = UBOUND(VAR$, 1)
  28.   VM = UBOUND(HELP$, 1)
  29.   HN = UBOUND(VAR$, 2)
  30.   HM = UBOUND(HELP$, 2)
  31.   REDIM COLPOS(HN)
  32.   LOCATE ROW%, COL%
  33.   FOR J = 1 TO VN
  34.   LOCATE ROW% + VSPACING% * (J - 1), COL%
  35.   FOR I = 1 TO HN
  36.     IF I = 1 AND J = 1 THEN
  37.        HOR = 1
  38.        VERT = 1
  39.        GOSUB HELPH
  40.        COLOR HLFG%, HLBG%
  41.     ELSE
  42.        COLOR FG%, BG%
  43.     END IF
  44.     IF J = 1 THEN COLPOS(I) = POS(0)
  45.     PRINT VAR$(J, I);
  46.     IF I < HN THEN
  47.        COLOR FG%, BG%
  48.        LOCATE , POS(0) + HSPACING%
  49.     END IF
  50.   NEXT I
  51.   NEXT J
  52.    LOCATE ROW%, COL%
  53.    VERT = 1
  54.    HOR = 1
  55. 140 I$ = INKEY$: IF I$ = "" THEN 140
  56.    IA = ASC(RIGHT$(I$, 1))
  57.    L = LEN(I$)
  58.    IF L = 2 AND IA = 77 THEN '  RIGHT ARROW
  59.       COLOR FG%, BG%
  60.       IND = 0
  61.       DO
  62.       IND = IND + 1
  63.       LOOP UNTIL POS(0) = COLPOS(IND)
  64.       PRINT VAR$(VERT, IND);
  65.       IF IND < HN THEN
  66.          LOCATE , POS(0) + HSPACING%
  67.          COLOR HLFG%, HLBG%
  68.          PRINT VAR$(VERT, IND + 1);
  69.          HOR = IND + 1
  70.       ELSE
  71.          LOCATE , COL%
  72.          COLOR HLFG%, HLBG%
  73.          PRINT VAR$(VERT, 1);
  74.          HOR = 1
  75.       END IF
  76.       LOCATE , COLPOS(HOR)
  77.       GOSUB HELPH
  78.    END IF
  79.    IF L = 2 AND IA = 75 THEN '  LEFT ARROW
  80.       COLOR FG%, BG%
  81.       IND = 0
  82.       DO
  83.       IND = IND + 1
  84.       LOOP UNTIL POS(0) = COLPOS(IND)
  85.       PRINT VAR$(VERT, IND);
  86.       IF IND > 1 THEN
  87.          COLOR HLFG%, HLBG%
  88.          LOCATE , COLPOS(IND - 1)
  89.          PRINT VAR$(VERT, IND - 1);
  90.          HOR = IND - 1
  91.       ELSE
  92.          LOCATE , COLPOS(HN)
  93.          COLOR HLFG%, HLBG%
  94.          PRINT VAR$(VERT, HN);
  95.          HOR = HN
  96.       END IF
  97.       LOCATE , COLPOS(HOR)
  98.       GOSUB HELPH
  99.    END IF
  100.    HKOL = COLPOS(HOR)
  101.    IF L = 2 AND IA = 80 THEN '  DOWN ARROW
  102.       COLOR FG%, BG%
  103.       RO = CSRLIN
  104.       IND = (RO - ROW%) \ VSPACING% + 1
  105.       LOCATE RO, HKOL
  106.       PRINT VAR$(IND, HOR);
  107.       COLOR HLFG%, HLBG%
  108.       IF IND < VN THEN
  109.          LOCATE RO + VSPACING%, HKOL
  110.          PRINT VAR$(IND + 1, HOR);
  111.          LOCATE RO + VSPACING%, HKOL
  112.          VERT = IND + 1
  113.       ELSE
  114.          LOCATE ROW%, HKOL
  115.          PRINT VAR$(1, HOR);
  116.          LOCATE ROW%, HKOL
  117.          VERT = 1
  118.       END IF
  119.       GOSUB HELPH
  120.    END IF
  121.    IF L = 2 AND IA = 72 THEN '  UP ARROW
  122.       COLOR FG%, BG%
  123.       RO = CSRLIN
  124.       IND = (RO - ROW%) \ VSPACING% + 1
  125.       LOCATE RO, HKOL
  126.       PRINT VAR$(IND, HOR);
  127.       COLOR HLFG%, HLBG%
  128.       IF IND > 1 THEN
  129.          LOCATE RO - VSPACING%, HKOL
  130.          PRINT VAR$(IND - 1, HOR);
  131.          LOCATE RO - VSPACING%, HKOL
  132.          VERT = IND - 1
  133.       ELSE
  134.          LOCATE ROW% + VSPACING% * (VN - 1), HKOL
  135.          PRINT VAR$(VN, HOR);
  136.          LOCATE ROW% + VSPACING% * (VN - 1), HKOL
  137.          VERT = VN
  138.       END IF
  139.       GOSUB HELPH
  140.    END IF
  141.    IF L = 1 AND IA = 13 THEN '  ENTER KEY
  142.       IND = 0
  143.       DO
  144.       IND = IND + 1
  145.       LOOP UNTIL POS(0) = COLPOS(IND)
  146.       HMENU% = IND
  147.       VMENU% = VERT
  148.       COLOR FG%, BG%
  149.       EXIT SUB
  150.    END IF
  151.    IF L = 1 AND IA = 27 THEN '  Esc KEY
  152.       HMENU% = 0
  153.       VMENU% = 0
  154.       COLOR FG%, BG%
  155.       EXIT SUB
  156.    END IF
  157.    IF L = 1 THEN   ' MATCH SINGLE KEY WITH FIRST LETTER OF SOME ITEM
  158.       FOR J = 1 TO VN
  159.       FOR I = 1 TO HN
  160.         IF I$ = LEFT$(VAR$(J, I), 1) THEN
  161.            COLOR FG%, BG%
  162.            IND = 0
  163.            DO
  164.            IND = IND + 1
  165.            LOOP UNTIL POS(0) = COLPOS(IND)
  166.            PRINT VAR$(VERT, IND);
  167.            COLOR HLFG%, HLBG%
  168.            LOCATE ROW% + (J - 1) * VSPACING%, COLPOS(I)
  169.            PRINT VAR$(J, I);
  170.            HOR = I
  171.            VERT = J
  172.            LOCATE , COLPOS(I)
  173.            GOSUB HELPH
  174.            GOTO 140
  175.         END IF
  176.       NEXT I
  177.       NEXT J
  178.    END IF
  179.    GOTO 140
  180. HELPH:
  181.    ROWSAVE = CSRLIN
  182.    COLSAVE = POS(0)
  183.    IF LENHELP > 0 THEN
  184.       LOCATE HROW%, HCOL%
  185.       COLOR 0, 0
  186.       PRINT SPACE$(LENHELP);
  187.    END IF
  188.    IF VERT <= VM AND HOR <= HM THEN
  189.       COLOR HFG%, HBG%
  190.       LOCATE HROW%, HCOL%
  191.       PRINT HELP$(VERT, HOR);
  192.       LENHELP = LEN(HELP$(VERT, HOR))
  193.    END IF
  194.    LOCATE ROWSAVE, COLSAVE
  195.    RETURN
  196. END SUB
  197.